home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 001-010 / amok06 / mathlib / r2test.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  114 lines
  1. (**********************************************************************
  2.  
  3.     :Program.       R2Test.mod
  4.     :Contents.     Testmodule for MathLibR2
  5.     :Author.        Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Phone.      711/333679
  8.     :Copyright.  Public Domain
  9.     :Language.      Modula-2
  10.     :Translator. M2Amiga AMSoft
  11.     :Imports.     MathLibR2, IntuiStruct [bne]
  12.     :ModHistory. V1.0 [bne] 16.07.88 (Demo Amok#4)
  13.     
  14. **********************************************************************)
  15.  
  16. MODULE R2Test;
  17.  
  18. FROM MathLibR2    IMPORT Vector2,Matrix2,Add2,Trans2,Mmul2,Scalar,Invert2;
  19. FROM IntuiStruct IMPORT StructScreen,StructWindow;
  20. FROM Graphics    IMPORT RastPortPtr,Draw,Move,SetDrMd,SetAPen,ViewModes,
  21.         ViewModeSet,jam1,WaitTOF,RectFill;
  22. FROM Exec    IMPORT WaitPort;
  23. FROM Intuition    IMPORT ScreenPtr,WindowPtr,ScreenFlags,ScreenFlagSet,
  24.         WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,
  25.                 customScreen,stdScreenHeight,NewScreen,NewWindow,
  26.                 OpenScreen,OpenWindow,CloseScreen,CloseWindow;
  27. FROM Arts    IMPORT Assert;
  28. FROM SYSTEM    IMPORT ADR;
  29. FROM MathTrans    IMPORT Sin,Cos;
  30.  
  31. CONST    Ox=160;
  32.     Oy=122;
  33.     phi=0.05;
  34.         grow=1.005;
  35.  
  36. VAR    Screen:ScreenPtr;
  37.     Window:WindowPtr;
  38.         MyScreen:NewScreen;
  39.         MyWindow:NewWindow;
  40.         RastPort:RastPortPtr;
  41.         Point:ARRAY [1..4] OF Vector2;
  42.         Matrix:Matrix2;
  43.         Vector:Vector2;
  44.         n,m:INTEGER;
  45.  
  46. PROCEDURE Round(X:Scalar):INTEGER;
  47. BEGIN
  48.   RETURN INTEGER(X+0.5);
  49. END Round;
  50.  
  51. PROCEDURE DeleteSquare;
  52. VAR    n:INTEGER;
  53. BEGIN
  54.   SetAPen(RastPort,0);
  55.   RectFill(RastPort,2,10,317,242);
  56. END DeleteSquare;
  57.  
  58. PROCEDURE DrawSquare;
  59. VAR    n:INTEGER;
  60. BEGIN
  61.   SetAPen(RastPort,1);
  62.   Move(RastPort,Round(Point[4].x)+Ox,Round(Point[4].y)+Oy);
  63.   FOR n:=1 TO 4 DO
  64.     Draw(RastPort,Round(Point[n].x)+Ox,Round(Point[n].y)+Oy);
  65.   END;
  66. END DrawSquare;
  67.  
  68. BEGIN
  69.   StructScreen(MyScreen,1,0,1,ViewModeSet{},customScreen,ADR("R² Test"));
  70.   Screen:=OpenScreen(MyScreen);
  71.   Assert(Screen#NIL,ADR("Screen klemmt"));
  72.   StructWindow(MyWindow,0,12,320,244,-1,-1,IDCMPFlagSet{closeWindow},
  73.       WindowFlagSet{windowClose,simpleRefresh,noCareRefresh,backDrop},
  74.         NIL,Screen,customScreen);
  75.   Window:=OpenWindow(MyWindow);
  76.   Assert(Window#NIL,ADR("Window klemmt"));
  77.   RastPort:=Window^.rPort;
  78.   SetDrMd(RastPort,jam1);
  79.   Point[1].x:=-50.0;    (* Quadrat *)
  80.   Point[1].y:=-50.0;
  81.   Point[2].x:=-50.0;
  82.   Point[2].y:=50.0;
  83.   Point[3].x:=50.0;
  84.   Point[3].y:=50.0;
  85.   Point[4].x:=50.0;
  86.   Point[4].y:=-50.0;
  87.   Matrix[1,1]:=Cos(phi)*grow; (* Drehmatrix + zentr. Streckung um "grow" *)
  88.   Matrix[1,2]:=-Sin(phi)*grow;
  89.   Matrix[2,1]:=Sin(phi)*grow;
  90.   Matrix[2,2]:=Cos(phi)*grow;
  91.   DrawSquare;
  92.   FOR n:=1 TO 200 DO
  93.     FOR m:=1 TO 4 DO
  94.       Trans2(Matrix,Point[m],Point[m]); (* 200 mal vorwärts *)
  95.     END;
  96.     WaitTOF;
  97.     DeleteSquare;
  98.     DrawSquare;
  99.   END;
  100.   IF Invert2(Matrix) THEN END; (* Umkehrung *)
  101.   Mmul2(Matrix,Matrix,Matrix); (* Abbildung verdoppeln *)
  102.   FOR n:=1 TO 100 DO
  103.     FOR m:=1 TO 4 DO
  104.       Trans2(Matrix,Point[m],Point[m]); (* 100 mal doppelt rückwärts *)
  105.     END;
  106.     WaitTOF;
  107.     DeleteSquare;
  108.     DrawSquare;
  109.   END;
  110.   WaitPort(Window^.userPort);
  111.   CloseWindow(Window);
  112.   CloseScreen(Screen);
  113. END R2Test.
  114.